home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / intrfc70.zip / INTRFC.PAS < prev    next >
Pascal/Delphi Source File  |  1994-03-16  |  4KB  |  139 lines
  1. program intrfc;
  2. {  Prints out the information contained in a TPU file  }
  3. {$I SWITCHES.INC}
  4.  
  5. uses
  6.   test1,nametype,util,globals,loader,head,blocks,namelist,srcfiles,code,
  7.         reloc,dump,params;
  8.  
  9. var
  10.   i,j,t:word;
  11.   result : word;
  12.   this_unit : obj_ptr;
  13.   tpu_size : longint;
  14.   main_list : list_ptr;
  15.   s:string;
  16. begin
  17.   WriteOutput('INTRFC version 7.00.  Written by D.J. Murdoch & M. Dadok.');
  18.  
  19.   parse_params;
  20.  
  21.   writeln('Dump of file ',unitname,unit_ext);
  22.  
  23.   S:=unitname+unit_ext;
  24.   ReadPathFile(S,header);
  25.   if header = nil then
  26.   begin
  27.     S:=tpl_name;
  28.     ReadPathFile(S,header);
  29.   end;
  30.   if header = nil then
  31.     syntax_exit('Error: can''t find unit '+unitname+unit_ext+', '+
  32.                 'TURBO.TPL, TPP.TPL or TPW.TPL.');
  33.   dispose(header);
  34.  
  35.   loadtpl;
  36.   num_known := 0;
  37.   fillchar(unit_list,sizeof(unit_list),0);
  38.   add_unit(unitname,nil);
  39.   if not unit_list[1]^.has_symbols then
  40.     syntax_exit('');
  41.  
  42.   buffer := unit_list[1]^.buffer;
  43.   header := header_ptr(buffer);
  44.  
  45.   {Make this unit refer to itself}
  46.   this_unit := add_only_offset(buffer,header^.ofs_this_unit);
  47.   unit_ptr(add_only_offset(buffer,
  48.            header^.ofs_this_unit+length(this_unit^.name)+4))^.target := 1;
  49.  
  50.   with header^ do
  51.     begin
  52. {$IFDEF UNIT60}
  53.       code_ofs  := roundup(sym_size,16);
  54. {$ELSE}
  55.       browser_ofs := roundup(sym_size,16);
  56.       code_ofs  := browser_ofs + roundup(browser_size,16);
  57. {$ENDIF}
  58.       const_ofs := code_ofs + roundup(code_size,16);
  59.       reloc_ofs := const_ofs + roundup(const_size,16);
  60.       const_reloc_ofs   := reloc_ofs + roundup(reloc_size,16);
  61.       tpu_size := longint(roundup(sym_size,16))
  62. {$IFNDEF UNIT60}
  63.                  +longint(roundup(browser_size,16))
  64. {$ENDIF}
  65.                  +longint(roundup(code_size,16))
  66.                  +longint(roundup(const_size,16))
  67.                  +longint(roundup(reloc_size,16))
  68.                  +longint(roundup(const_reloc_size,16));
  69.     end;
  70.  
  71.   hash_table := add_only_offset(buffer,header^.ofs_hashtable);
  72.   if do_implementation in active_options then
  73.     hash_table := add_only_offset(buffer,header^.ofs_full_hash);
  74.  
  75.   {Build main object list}
  76.  
  77.   build_list(main_list,buffer,hash_table);
  78.   unit_list[1]^.obj_list := main_list;
  79.  
  80.   { Now print it }
  81.   in_function := false;
  82.   NowEnum := nil;
  83.   indentation := 0;
  84.   if do_header in active_options then
  85.     print_header;
  86.   if [do_name_list,do_implementation]*active_options <> [] then
  87.     print_name_list(main_list);
  88.   if do_src_files in active_options then
  89.     print_src_files;
  90.   if do_src_lines in active_options then
  91.     print_src_lines;
  92.   if do_entry_pts in active_options then
  93.     print_entries;
  94.   if do_code_blocks in active_options then
  95.     print_code_blocks;
  96.   if do_const_blocks in active_options then
  97.     print_const_blocks;
  98.   if do_var_blocks in active_options then
  99.     print_var_blocks;
  100.   if do_dll_blocks in active_options then
  101.     print_dll_blocks;
  102.   if do_unit_blocks in active_options then
  103.     print_unit_blocks;
  104. {$IFNDEF UNIT60}
  105.   if do_browser in active_options then
  106.   begin
  107.     read_file(unit_list[1]^.path,pointer(browser_buf),browser_ofs,header^.browser_size);
  108.     print_browser;
  109.     freemem(browser_buf,header^.browser_size);
  110.   end;
  111. {$ENDIF}
  112.   if do_code in active_options then
  113.   begin
  114.     read_file(unit_list[1]^.path,pointer(code_buf),code_ofs,header^.code_size);
  115.     print_dump(code_seg);
  116.     freemem(code_buf,header^.code_size);
  117.   end;
  118.   if do_const in active_options then
  119.   begin
  120.     read_file(unit_list[1]^.path,pointer(code_buf),const_ofs,header^.const_size);
  121.     print_dump(const_seg);
  122.     freemem(code_buf,header^.const_size);
  123.   end;
  124.   if do_reloc in active_options then
  125.   begin
  126.     read_file(unit_list[1]^.path,pointer(reloc_buf),reloc_ofs,header^.reloc_size);
  127.     print_reloc(code_seg);
  128.     freemem(reloc_buf,header^.reloc_size);
  129.   end;
  130.   if do_vmt in active_options then
  131.   begin
  132.     read_file(unit_list[1]^.path,pointer(reloc_buf),const_reloc_ofs,header^.const_reloc_size);
  133.     print_reloc(const_seg);
  134.     freemem(reloc_buf,header^.const_reloc_size);
  135.   end;
  136.  
  137.   ErrorStatus;
  138. end.
  139.